home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJDSKR2.CLS < prev    next >
Encoding:
Text File  |  1996-04-15  |  3.7 KB  |  127 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjDisk"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' The plane that contains the disk.
  11. Private plane As New ObjPlane
  12.  
  13. Private Center As Point3D   ' Coordinates of center.
  14. Private Radius As Integer   ' Radius.
  15. ' ************************************************
  16. ' Set constants for reflection.
  17. ' ************************************************
  18. Sub SetKr(r As Single, G As Single, B As Single)
  19.     plane.SetKr r, G, B
  20. End Sub
  21.  
  22. ' ************************************************
  23. ' Set constants for transmitted light.
  24. ' ************************************************
  25. Sub SetKt(n As Single, N1 As Single, N2 As Single, r As Single, G As Single, B As Single)
  26.     plane.SetKt n, N1, N2, r, G, B
  27. End Sub
  28.  
  29. ' ************************************************
  30. ' Return the red, green, and blue components of
  31. ' the surface at the hit position.
  32. ' ************************************************
  33. Public Sub HitColor(depth As Integer, Objects As Collection, r As Integer, G As Integer, B As Integer)
  34.     plane.HitColor depth, Objects, r, G, B
  35. End Sub
  36.  
  37. ' ************************************************
  38. ' Compute the distance from point (px, py, pz)
  39. ' along vector <vx, vy, vz> to the disk.
  40. ' ************************************************
  41. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  42. Dim dist As Single
  43. Dim x As Single
  44. Dim y As Single
  45. Dim z As Single
  46. Dim dx As Single
  47. Dim dy As Single
  48. Dim dz As Single
  49.  
  50.     ' Find the distance to the plane.
  51.     dist = plane.RayDistance(px, py, pz, Vx, Vy, Vz)
  52.     
  53.     ' If there is no good intersection with the
  54.     ' plane, there's none with the disk.
  55.     If dist >= INFINITY Then
  56.         RayDistance = INFINITY
  57.         Exit Function
  58.     End If
  59.  
  60.     ' See if the point of intersection lies within
  61.     ' the disk.
  62.     
  63.     ' Get the hit location.
  64.     plane.HitLocation x, y, z
  65.  
  66.     ' See if the point lies within distance Radius
  67.     ' of the center.
  68.     dx = Center.trans(1) - x
  69.     dy = Center.trans(2) - y
  70.     dz = Center.trans(3) - z
  71.     If Sqr(dx * dx + dy * dy + dz * dz) > Radius Then
  72.         RayDistance = INFINITY
  73.         Exit Function
  74.     End If
  75.     
  76.     RayDistance = dist
  77. End Function
  78.  
  79.  
  80.  
  81. ' ***********************************************
  82. ' Define the plane that contains the disk.
  83. ' ***********************************************
  84. Public Sub Initialize(r As Single, cx As Single, cy As Single, cz As Single, nx As Single, ny As Single, nz As Single)
  85.     Radius = r
  86.     Center.coord(1) = cx
  87.     Center.coord(2) = cy
  88.     Center.coord(3) = cz
  89.     Center.coord(4) = 1
  90.     plane.Initialize cx, cy, cz, nx, ny, nz
  91. End Sub
  92.  
  93.  
  94.  
  95. ' ************************************************
  96. ' Set constants for diffuse reflection.
  97. ' ************************************************
  98. Sub SetKd(r As Single, G As Single, B As Single)
  99.     plane.SetKd r, G, B
  100. End Sub
  101. ' ************************************************
  102. ' Set constants for ambient light.
  103. ' ************************************************
  104. Sub SetKa(r As Single, G As Single, B As Single)
  105.     plane.SetKa r, G, B
  106. End Sub
  107. ' ************************************************
  108. ' Set N and Ks for specular reflection.
  109. ' ************************************************
  110. Sub SetSpec(n As Single, s As Single)
  111.     plane.SetSpec n, s
  112. End Sub
  113.  
  114. ' ************************************************
  115. ' Apply a transformation matrix to the object.
  116. ' ************************************************
  117. Public Sub Apply(M() As Single)
  118.     m3Apply Center.coord, M, Center.trans
  119.     plane.Apply M
  120. End Sub
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.